perm filename DV.FIX[MF,ALS]2 blob sn#774828 filedate 1984-11-07 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	This page reserved for gf to raster
C00011 00003	This page reserved for raster to im_press
C00019 ENDMK
C⊗;
This page reserved for gf to raster

Since we are going to defer the actual creation of an \.{imPRESS} |bgly|
command for each glyph until the first time that it is actually called, we
will now only decypher the |gf| commands far enough to determine if they are to
be saved and to properly store them away for further use.

@p function in_gf(@!z:integer):boolean; {input \.{GF} data or return |false|}
label 9997, {go here when the format is bad}
{|	9998,|}	{go here when the information cannot be loaded}
	9999;	{go here to exit}
var k:integer; {index for loops}
@!lh:integer; {length of the header data, in four-byte words}
@!nw:integer; {number of words in the width table}
@!wp:0..max_widths; {new value of |width_ptr| after successful input}
@!alpha,@!beta:integer; {quantities used in the scaling computation}
begin
find_gf_postamble; read_gf_postamble;
@<Process the gf_preamble@>;
@<Translate all the characters@>;

begin @<Read past the header data; |goto 9997| if there is a problem@>;
@<Store character-width indices at the end of the |width| table@>;
@<Read and convert the width values, setting up the |in_width| table@>;
@<Move the widths from |in_width| to |width|, and append |pixel_width| values@>;
width_ptr←wp;

 in_gf←true; goto 9999;
9997: print_ln('---not loaded, GF file is bad');
@.GF file is bad@>
{|9998: in_gf←false;|}
9999: end;

@ @<Glob...@>=
@!glyph_pointers:array[0..max_fonts,0..127] of integer;
@!rasters:array[0..raster_size] of eight_bits;


@ The following definitions simplify the writing and reading of the code
that tabulates and later interprets the raster information.

@d white==0 {could also be |false|}
@d black==1 {could also be |true|}
@d complement(#)==if #=black then #←white@+else #←black

@<Types...@>=
@!pixel=white..black; {could also be |boolean|}

@ Let's keep track of how many characters are in the font, and the
locations of where each one occured in the file.

@<Glob...@>=
@!total_chars:integer; {the total number of characters seen so far}
@!char_ptr: array[0..max_glyph_no] of integer; {character location pointer}
@!gf_prev_ptr: integer; {|char_ptr| for next character}
@!char_code: integer; {current character number}

@ @<Set init...@>=
for i←0 to max_glyph_no do char_ptr[i]←-1; 
      {mark characters as not being in the file}
total_chars←0;

@ Before we get into the details of |do_char|, it is convenient to
consider a simpler routine that computes the first parameter of each
opcode.

@d three_cases(#)==#,#+1,#+2
@d four_cases(#)==#,#+1,#+2,#+3
@d eight_cases(#)==four_cases(#),four_cases(#+4)
@d nine_cases(#)==eight_cases(#),#+8
@d sixteen_cases(#)==eight_cases(#),eight_cases(#+8)
@d nineteen_cases(#)==nine_cases(#),nine_cases(#+9),#+18
@d thirty_two_cases(#)==sixteen_cases(#),sixteen_cases(#+16)
@d sixty_four_cases(#)==thirty_two_cases(#),thirty_two_cases(#+32)
@d eighty_three_cases(#)==sixty_four_cases(#),nineteen_cases(#+64)

@p function first_par(o:eight_bits):integer;
begin case o of
sixty_four_cases(paint_0): first_par←o-paint_0;
paint1,skip1,char_loc,xxx1: first_par←get_gf_byte;
paint1+1,skip1+1,xxx1+1: first_par←get_gf_two_bytes;
paint1+2,skip1+2,xxx1+2: first_par←get_gf_three_bytes;
new_row,xxx1+3,yyy: first_par←gf_signed_quad;
nop,boc,eoc,gf_pre,gf_post,gf_post_post,undefined_commands: first_par←0;
eighty_three_cases(left_z_83), right_z_0,
	eighty_three_cases(right_z_1): first_par←o-right_z_0;
end;
end;

@ The |do_char| routine is written as a function that returns the value
|false| if the program should be aborted because of some unusual
happening. It is organized as a typical interpreter, with a multiway
branch on the command code.

@p function do_char:boolean;
label 9998,9999;
var o:eight_bits; {operation code of the current command}
@!p,@!q:integer; {parameters of the current command}
i,j:integer; {used as indices}
b:eight_bits; {holding byte for oc bits}
begin {we've already scanned the |boc|}
do_char←true;
while true do @<Translate the next command in the \.{GF} file;
		|goto 9999| if it was |eoc|;
		|goto 9998| if premature termination is needed@>;
9998: print_ln('!'); do_char←false;
9999:end;

@ @d show_label(#)==print(a:1,': ',#)
@d error(#)==begin show_label('! ',#); print_nl; end
@d start_op==a←gf_cur_loc; o←get_gf_byte; p←first_par(o);
	if eof(gf_file) then bad_gf('the file ended prematurely')
@.the file ended prematurely@>

@<Translate the next command...@>=
begin start_op;
@<Start translation of command |o| and |goto| the appropriate label to
	finish the job@>;
end




93: beginning of char 53: -29<=x<-7 40<=y<77
(initially y=76, z=-26) paint 2(12)2
125: newrow 0 (y=75, z=-26) paint 5(7)4
129: newrow 0 (y=74, z=-26) paint 15

5076: beginning of char 20: 4<=x<30 -7<=y<27
(initially y=26, z=27) paint 3
5106: newrow -2 (y=25, z=25) paint 5
5154: newrow -23 (y=1, z=4)
5155: skip1 6 (y=-6, z=4) paint 26
5158: newrow 0 (y=-7, z=4) paint 26


5161: beginning of char 21: 4<=x<30 -7<=y<27
(initially y=26, z=4) paint 3
5191: newrow 0 (y=25, z=4) paint 5
5237: newrow 0 (y=2, z=4) paint 3
5239: skip1 7 (y=-6, z=4) paint 26
5242: newrow 0 (y=-7, z=4) paint 26

(4)5(12)7
b←32-(4+5+12+7)
str ←(4)5(12)7(b)
      a b  c d e


allow for (0)1(1)1(1)1(1)1(x) or (1)1(1)1(1)1(1)1(x)

dx←max_x-min_x+1;

This page reserved for raster to im_press

@p procedure im_halfword(@!w:integer);
begin
if w<0 then w←w+@"10000;
im_byte(w div @"100);
im_byte(w mod @"100);
end;
@#
procedure im_word(@!w:integer);
begin
if w>0 then im_byte(w div @"1000000)
else begin
	w:=w+@"40000000;
	w:=w+@"40000000;
	im_byte((w div @"1000000) + 128);
	end;
im_byte((w div @"10000) mod @"100);
im_byte((w div @"100) mod @"100);
im_byte(w mod @"100);
end;

@ @<Accept a |boc|...@>=
a←r_c;
incr(total_chars); {a record of the number of characters downloaded}
read_signed_quad; char_code←par;
read_signed_quad; p←par;
c←char_code mod 256;
if c<0 then c←c+256;
print(c:1);
if char_code≠c then
	print(' in family ',(char_code-c) div 256 : 1);
read_signed_quad; min_x_stated←par; read_signed_quad; max_x_stated←par;
read_signed_quad; min_y_stated←par; read_signed_quad; max_y_stated←par;
read_signed_quad; z←par;
min_z←z;
if char_ptr[c]≠p then
	error('previous character pointer should be ',char_ptr[c]:1,
		', not ',p:1,'!');
char_ptr[c]←gf_prev_ptr;
y←max_y_stated;
x←z;
n_r_flag←true; {to handle an immediate skip instruction should one be given}
im_byte(bgly);
par←f*128+c; im_halfword(par);


@ @<Translate a |new_row|, |right| or |left| command@>=
begin
n_r_flag←true;
decr(y); z←z+p; x←z;
@<finish translation of the previous paint commands if any@>;
w←z;
if z<min_z then min_z←z;

@<Translate a sequence of paint commands@>=
n←0; dis←0; val←0;
while n<bytes_required do
  begin
  if dis=0 then
    begin
    @<Get two paint commands@>;
    dis←w+b;
    end;
  while dis<8 do
      begin
      val←val+wtab[w]-wtab[dis];
      @<Get two paint commands@>;
      w←dis+w; dis←w+b;
      end;
  if w≥8 then
      begin
      im_byte(val); incr(n); w←w-8; dis←dis-8; val←0;
      end
      else
      begin
      im_byte(val+btab[w]); incr(n); w←0; dis←dis-8; val←0;
      end;
  end;

@<Get two paint commands@>=
if n_r_flag=false then 
  begin 
  if rasters[r_c]≤pain1+3 then
    begin  rast_op; w←p;
    end else  w←8*bytes_required; {a safety measure}
  end;
if rasters[r_c]≤pain1+3 then
  begin  rast_op; b←p;
  end else  b←0;
n_r_flag←false;

@d read_byte==begin par←rasters[r_c]; incr[r_c]; end
@d read_two_bytes==begin read_byte;
	par←par*256+rasters[r_c]; incr(r_c);
	end
@d read_three_bytes==begin read_two_bytes;
	par←par*256+rasters[r_c]; incr(r_c);
	end
@d read_signed_quad==begin read_byte; 
	if par<128 then 
	  begin
	  par←par*256+rasters[r_c]; incr(r_c);
	  par←par*256+rasters[r_c]; incr(r_c);
	  par←par*256+rasters[r_c]; incr(r_c);
	  end
	  else
	  begin
	  par←(par-256)*256+rasters[r_c]; incr(r_c);
	  par←par*256+rasters[r_c]; incr(r_c);
	  par←par*256+rasters[r_c]; incr(r_c);
	  end;
	end

@d rast_op==o←rasters[r_p]; incr(r_c);
	if o>240 then error('bad |rasters| formulation');
	 p←first_rast_par(o);

@p function first_rast_par(o:eight_bits):integer;
begin case o of
sixty_four_cases(paint_0): first_rast_par←o-paint_0;
paint1,skip1,char_loc,xxx1: read_byte; first_rast_par←par;
paint1+1,skip1+1,xxx1+1: read_two_bytes; first_rast_par←par;
paint1+2,skip1+2,xxx1+2: read_three_bytes; first_rast_par←par;
new_row,xxx1+3,yyy: read_signed_quad; first_rast_par←par;
nop,boc,eoc,gf_pre,gf_post,gf_post_post,undefined_commands: first_rast_par←0;
eighty_three_cases(left_z_83), right_z_0,
	eighty_three_cases(right_z_1): first_rast_par←o-right_z_0;
end;
end;

@<
@<Glob...@>=
@!val:integer; {used to accumulate raster data}
@!dis:integer; {used to measure distance along a row}
@!par:integer; {holding current parameter}
@!char_code:integer; {the current character code}
@!glyph_pointers:array[0..max_fonts,0..127] of integer;
@!rasters:array[0..raster_size] of eight_bits;
@!r_c:integer; {the index to |rasters|}
@!wtab:array[0..8] of integer; {for black streaks contained within a byte}
@!btab:array[0..8] of integer; {for black streaks going to end of a byte}

@<Set initial values@>=
wtab[0]←256; btab[0]←255;
for i←1 to 8 do 
  begin 
  wtab[i]←wtab[i-1] div 2;
  btab[i]←wtab[i]-1;
  end;

value	wtab	btab
0	256	255
1	128	127
2	64	63
3	32	31
4	16	15
5	8	7
6	4	3
7	2	1
8	1	0

@ @<Translate a |new_row|, |right| or |left| command@>=
begin
n_r_flag←true;
decr(y); z←z+p; x←z;
if z<min_z then min_z←z;
p_c←0; 
  p_val←white; 
  p_array←z;
  incr(p_c);
  p_array←0; {to clear the next |p_c| location}
end

@<Translate a sequence of |paint| commands...@>=
begin
n_r_flag←false;
repeat @<Store it away@>;
start_op;
until o>paint1+3;
end

@ @<Store it away@>=
p_array←p;
incr(p_c);
p_array←0;
x←x+p;